설명과 첨언의 글이 많아 이후 경어는 생략하고 진행하겠습니다.
참조 1. https://www.kaggle.com/erikbruin/house-prices-lasso-xgboost-and-a-detailed-eda/report
https://www.kaggle.com/chocozzz/house-price-prediction-eda-updated-2019-03-12
https://www.kaggle.com/psystat/house-price-prediction-eda-and-lasso-with-r
캐글코리아 주최 2회째 Competition으로 주제는 House price prediction이다. 분석 언어는 ’R’을 쓰며, 주 패키지는 분석용 dplyr와 시각화 ggplot2이며, 이 두 패키지가 포함된 tidyverse를 쓸 예정이다. 교육 과정 제출용 포트폴리오이며, 참조한 커널은 링크를 첨부한다.
library(tidyverse) # ggplot2, dplyr, tidyr, tibble, readr 외 다양한 패키지가 있는 복합 패키지
library(corrplot) # 시각화 사용(상관 계수 파악)
library(data.table) # data Load
library(plotly) # price 변수 인터랙티브 그래프 확인
library(scales) # 그래프 축 수치 변경
library(gridExtra) # 차트 멀티 표현
library(Rmisc) # multiplot
library(zipcode) # zipcode to city 변환
library(ggiraphExtra)# 지도 매핑 & 시각화
library(psych) # Skewness
library(caret) # preProcess
library(summarytools)# summary & 내용 개요
library(xgboost) # xgboost model
library(tictoc) # tic 함수
## Load Data
k_train <- fread("./kako 2nd/train.csv")
k_test <- fread("./kako 2nd/test.csv")
dim(k_train) # 21개 변수의 15035 관측치다.
## [1] 15035 21
dim(k_test) # price를 제외한 20개 변수의 6468 관측치이며, k_train대비 비율은 5:2이다.
## [1] 6468 20
str(k_train) # 숫자 & 문자 변수 혼합 타입으로 구성된 2차원 이상의 데이터이다.
## Classes 'data.table' and 'data.frame': 15035 obs. of 21 variables:
## $ id : int 0 1 2 3 4 5 6 7 8 9 ...
## $ date : chr "20141013T000000" "20150225T000000" "20150218T000000" "20140627T000000" ...
## $ price : num 221900 180000 510000 257500 291850 ...
## $ bedrooms : int 3 2 3 3 3 3 2 3 3 5 ...
## $ bathrooms : num 1 1 2 2.25 1.5 2.5 1 1 1.75 2 ...
## $ sqft_living : int 1180 770 1680 1715 1060 3560 1160 1430 1370 1810 ...
## $ sqft_lot : int 5650 10000 8080 6819 9711 9796 6000 19901 9680 4850 ...
## $ floors : num 1 1 1 2 1 1 1 1.5 1 1.5 ...
## $ waterfront : int 0 0 0 0 0 0 0 0 0 0 ...
## $ view : int 0 0 0 0 0 0 0 0 0 0 ...
## $ condition : int 3 3 3 3 3 3 4 4 4 3 ...
## $ grade : int 7 6 8 7 7 8 7 7 7 7 ...
## $ sqft_above : int 1180 770 1680 1715 1060 1860 860 1430 1370 1810 ...
## $ sqft_basement: int 0 0 0 0 0 1700 300 0 0 0 ...
## $ yr_built : int 1955 1933 1987 1995 1963 1965 1942 1927 1977 1900 ...
## $ yr_renovated : int 0 0 0 0 0 0 0 0 0 0 ...
## $ zipcode : int 98178 98028 98074 98003 98198 98007 98115 98028 98074 98107 ...
## $ lat : num 47.5 47.7 47.6 47.3 47.4 ...
## $ long : num -122 -122 -122 -122 -122 ...
## $ sqft_living15: int 1340 2720 1800 2238 1650 2210 1330 1780 1370 1360 ...
## $ sqft_lot15 : int 5650 8062 7503 6819 9711 8925 6000 12697 10208 4850 ...
## - attr(*, ".internal.selfref")=<externalptr>
str(k_test) # 숫자 & 문자 변수 혼합 타입으로 구성된 2차원 이상의 데이터이다.
## Classes 'data.table' and 'data.frame': 6468 obs. of 20 variables:
## $ id : int 15035 15036 15037 15038 15039 15040 15041 15042 15043 15044 ...
## $ date : chr "20141209T000000" "20141209T000000" "20140512T000000" "20150415T000000" ...
## $ bedrooms : int 3 4 4 3 3 5 3 4 2 4 ...
## $ bathrooms : num 2.25 3 4.5 1 2.5 2.5 1.75 2.5 1.5 1 ...
## $ sqft_living : int 2570 1960 5420 1780 1890 2270 1520 2570 1190 1660 ...
## $ sqft_lot : int 7242 5000 101930 7470 6560 6300 6380 7173 1265 34848 ...
## $ floors : num 2 1 1 1 2 2 1 2 3 1 ...
## $ waterfront : int 0 0 0 0 0 0 0 0 0 0 ...
## $ view : int 0 0 0 0 0 0 0 0 0 0 ...
## $ condition : int 3 5 3 3 3 3 3 3 3 1 ...
## $ grade : int 7 7 11 7 7 8 7 8 7 5 ...
## $ sqft_above : int 2170 1050 3890 1050 1890 2270 790 2570 1190 930 ...
## $ sqft_basement: int 400 910 1530 730 0 0 730 0 0 730 ...
## $ yr_built : int 1951 1965 2001 1960 2003 1995 1948 2005 2005 1933 ...
## $ yr_renovated : int 1991 0 0 0 0 0 0 0 0 0 ...
## $ zipcode : int 98125 98136 98053 98146 98038 98092 98115 98052 98133 98052 ...
## $ lat : num 47.7 47.5 47.7 47.5 47.4 ...
## $ long : num -122 -122 -122 -122 -122 ...
## $ sqft_living15: int 1690 1360 4760 1780 2390 2240 1520 2630 1390 2160 ...
## $ sqft_lot15 : int 7639 5000 101930 8113 7570 7005 6235 6026 1756 11467 ...
## - attr(*, ".internal.selfref")=<externalptr>
k_test.labels <- k_test$id # modeling 대비 id 벡터에 저장
k_all <- bind_rows(within(k_train, rm('id')), within(k_test, rm('id')))
# rbind는 열 개수가 다르면 결합 불가. bind_rows는 없던 열 결측치로 대체하여 결합.
dim(k_all)
## [1] 21503 20
str(k_all)
## Classes 'data.table' and 'data.frame': 21503 obs. of 20 variables:
## $ date : chr "20141013T000000" "20150225T000000" "20150218T000000" "20140627T000000" ...
## $ price : num 221900 180000 510000 257500 291850 ...
## $ bedrooms : int 3 2 3 3 3 3 2 3 3 5 ...
## $ bathrooms : num 1 1 2 2.25 1.5 2.5 1 1 1.75 2 ...
## $ sqft_living : int 1180 770 1680 1715 1060 3560 1160 1430 1370 1810 ...
## $ sqft_lot : int 5650 10000 8080 6819 9711 9796 6000 19901 9680 4850 ...
## $ floors : num 1 1 1 2 1 1 1 1.5 1 1.5 ...
## $ waterfront : int 0 0 0 0 0 0 0 0 0 0 ...
## $ view : int 0 0 0 0 0 0 0 0 0 0 ...
## $ condition : int 3 3 3 3 3 3 4 4 4 3 ...
## $ grade : int 7 6 8 7 7 8 7 7 7 7 ...
## $ sqft_above : int 1180 770 1680 1715 1060 1860 860 1430 1370 1810 ...
## $ sqft_basement: int 0 0 0 0 0 1700 300 0 0 0 ...
## $ yr_built : int 1955 1933 1987 1995 1963 1965 1942 1927 1977 1900 ...
## $ yr_renovated : int 0 0 0 0 0 0 0 0 0 0 ...
## $ zipcode : int 98178 98028 98074 98003 98198 98007 98115 98028 98074 98107 ...
## $ lat : num 47.5 47.7 47.6 47.3 47.4 ...
## $ long : num -122 -122 -122 -122 -122 ...
## $ sqft_living15: int 1340 2720 1800 2238 1650 2210 1330 1780 1370 1360 ...
## $ sqft_lot15 : int 5650 8062 7503 6819 9711 8925 6000 12697 10208 4850 ...
sum(is.na(k_all))/(ncol(k_all)*nrow(k_all)) # train, test 결합하며 생긴 price의 결측치 같다.
## [1] 0.01503976
colSums(is.na(k_all)) #row 결합으로 생긴 price의 결측치만 보인다.
## date price bedrooms bathrooms sqft_living
## 0 6468 0 0 0
## sqft_lot floors waterfront view condition
## 0 0 0 0 0
## grade sqft_above sqft_basement yr_built yr_renovated
## 0 0 0 0 0
## zipcode lat long sqft_living15 sqft_lot15
## 0 0 0 0 0
# study 개념으로 시각화를 첨부한다.
# 각 feature 결측치 비율 계산
missing_values <- k_all %>% dplyr::summarise_all(funs(sum(is.na(.))/n()))
## Warning: funs() is soft deprecated as of dplyr 0.8.0
## please use list() instead
##
## # Before:
## funs(name = f(.)
##
## # After:
## list(name = ~f(.))
## This warning is displayed once per session.
# data frame 생성
missing_values <- tidyr::gather(missing_values, key = 'feature', value = 'missing_pct')
# 그래프 생성
missing_values %>%
ggplot(aes(x= reorder(feature, missing_pct), y = missing_pct)) + # missing_pct 내림차순 정렬
geom_bar(stat = 'identity', fill = 'red') + # 막대 그래프 생성
ggtitle('Rechecking missing values in each features') + # 제목
theme(plot.title = element_text(face = 'italic', # 글씨체
hjust = 0.5, # 가로비율(Horizon)
size = 15, # 폰트 크기
color = 'black')) + # 폰트 컬러
labs(x = 'Feature names', y = 'Rate') + # x, y 축 명명
coord_flip() # x, y 축 반전
# 시각화 확인 결과 데이터셋 합산하며 생긴 price 제외 NA는 없다.
head(k_all,10) # Chapter 3.3 설명대로 값들은 예상과 맞지만, date는 수정할 필요가 있어 보인다.
## date price bedrooms bathrooms sqft_living sqft_lot floors
## 1: 20141013T000000 221900 3 1.00 1180 5650 1.0
## 2: 20150225T000000 180000 2 1.00 770 10000 1.0
## 3: 20150218T000000 510000 3 2.00 1680 8080 1.0
## 4: 20140627T000000 257500 3 2.25 1715 6819 2.0
## 5: 20150115T000000 291850 3 1.50 1060 9711 1.0
## 6: 20150403T000000 662500 3 2.50 3560 9796 1.0
## 7: 20140527T000000 468000 2 1.00 1160 6000 1.0
## 8: 20140528T000000 310000 3 1.00 1430 19901 1.5
## 9: 20141007T000000 400000 3 1.75 1370 9680 1.0
## 10: 20150312T000000 530000 5 2.00 1810 4850 1.5
## waterfront view condition grade sqft_above sqft_basement yr_built
## 1: 0 0 3 7 1180 0 1955
## 2: 0 0 3 6 770 0 1933
## 3: 0 0 3 8 1680 0 1987
## 4: 0 0 3 7 1715 0 1995
## 5: 0 0 3 7 1060 0 1963
## 6: 0 0 3 8 1860 1700 1965
## 7: 0 0 4 7 860 300 1942
## 8: 0 0 4 7 1430 0 1927
## 9: 0 0 4 7 1370 0 1977
## 10: 0 0 3 7 1810 0 1900
## yr_renovated zipcode lat long sqft_living15 sqft_lot15
## 1: 0 98178 47.5112 -122.257 1340 5650
## 2: 0 98028 47.7379 -122.233 2720 8062
## 3: 0 98074 47.6168 -122.045 1800 7503
## 4: 0 98003 47.3097 -122.327 2238 6819
## 5: 0 98198 47.4095 -122.315 1650 9711
## 6: 0 98007 47.6007 -122.145 2210 8925
## 7: 0 98115 47.6900 -122.292 1330 6000
## 8: 0 98028 47.7558 -122.229 1780 12697
## 9: 0 98074 47.6127 -122.045 1370 10208
## 10: 0 98107 47.6700 -122.394 1360 4850
summary(k_all) # 수치형이지만 실제론 범주형인 값들이 보인다.
## date price bedrooms bathrooms
## Length:21503 Min. : 78000 Min. : 0.000 Min. :0.000
## Class :character 1st Qu.: 322000 1st Qu.: 3.000 1st Qu.:1.750
## Mode :character Median : 450000 Median : 3.000 Median :2.250
## Mean : 540683 Mean : 3.372 Mean :2.116
## 3rd Qu.: 645000 3rd Qu.: 4.000 3rd Qu.:2.500
## Max. :7700000 Max. :33.000 Max. :8.000
## NA's :6468
## sqft_living sqft_lot floors waterfront
## Min. : 290 Min. : 520 Min. :1.000 Min. :0.00000
## 1st Qu.: 1430 1st Qu.: 5040 1st Qu.:1.000 1st Qu.:0.00000
## Median : 1914 Median : 7616 Median :1.500 Median :0.00000
## Mean : 2081 Mean : 15117 Mean :1.495 Mean :0.00758
## 3rd Qu.: 2550 3rd Qu.: 10686 3rd Qu.:2.000 3rd Qu.:0.00000
## Max. :13540 Max. :1651359 Max. :3.500 Max. :1.00000
##
## view condition grade sqft_above
## Min. :0.0000 Min. :1.00 Min. : 1.000 Min. : 290
## 1st Qu.:0.0000 1st Qu.:3.00 1st Qu.: 7.000 1st Qu.:1200
## Median :0.0000 Median :3.00 Median : 7.000 Median :1560
## Mean :0.2346 Mean :3.41 Mean : 7.659 Mean :1790
## 3rd Qu.:0.0000 3rd Qu.:4.00 3rd Qu.: 8.000 3rd Qu.:2210
## Max. :4.0000 Max. :5.00 Max. :13.000 Max. :9410
##
## sqft_basement yr_built yr_renovated zipcode
## Min. : 0.0 Min. :1900 Min. : 0.00 Min. :98001
## 1st Qu.: 0.0 1st Qu.:1951 1st Qu.: 0.00 1st Qu.:98033
## Median : 0.0 Median :1975 Median : 0.00 Median :98065
## Mean : 291.7 Mean :1971 Mean : 84.74 Mean :98078
## 3rd Qu.: 560.0 3rd Qu.:1997 3rd Qu.: 0.00 3rd Qu.:98117
## Max. :4820.0 Max. :2015 Max. :2015.00 Max. :98199
##
## lat long sqft_living15 sqft_lot15
## Min. :47.16 Min. :-122.5 Min. : 399 Min. : 651
## 1st Qu.:47.47 1st Qu.:-122.3 1st Qu.:1490 1st Qu.: 5100
## Median :47.57 Median :-122.2 Median :1840 Median : 7620
## Mean :47.56 Mean :-122.2 Mean :1987 Mean : 12774
## 3rd Qu.:47.68 3rd Qu.:-122.1 3rd Qu.:2370 3rd Qu.: 10085
## Max. :47.78 Max. :-121.3 Max. :6210 Max. :871200
##
plot.categoric <- function(cols, df){
for (col in cols) {
order.cols <- names(sort(table(k_all[,col]), decreasing = TRUE))
num.plot <- qplot(df[,col]) +
geom_bar(fill = 'cornflowerblue') +
geom_text(aes(label = ..count..), stat='count', vjust=-0.5) +
theme_minimal() +
scale_y_continuous(limits = c(0,max(table(df[,col]))*1.1)) +
scale_x_discrete(limits = order.cols) +
xlab(col) +
theme(axis.text.x = element_text(angle = 30, size=12))
print(num.plot)
}
}
k_all[, date:=substr(date, 1, 8)] # date에서 불필요 부분 제거하여 연간 구매로 변수 생성
k_all %>% select(date) %>% head(10)
## date
## 1: 20141013
## 2: 20150225
## 3: 20150218
## 4: 20140627
## 5: 20150115
## 6: 20150403
## 7: 20140527
## 8: 20140528
## 9: 20141007
## 10: 20150312
summary(k_all$price) # price 분포 확인
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 78000 322000 450000 540683 645000 7700000 6468
price.g <- ggplot(data=k_all[!is.na(k_all$price)], aes(x=price)) +
geom_histogram(fill = 'red', binwidth = 10000) +
scale_x_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma)
ggplotly(price.g) # 인터랙티브 그래프로 금액대별 거래량 분포 확인
금액대는 35만에서 거래가 가장 많았으며, 평균은 54만이고, 75% 거래량 까지가 64만으로 주로 100만 안에서 거래량이 많았다. 200만이 넘어서는 10건 이하로 거래가 되었고, 4백만 이후부터는 1건씩 거래가 이루어졌다.
상관 관계 히트맵
str(k_all) # pearson(수치형) & spearman(수치 & 범주형 혼합) 계수 생성위해 확인
## Classes 'data.table' and 'data.frame': 21503 obs. of 20 variables:
## $ date : chr "20141013" "20150225" "20150218" "20140627" ...
## $ price : num 221900 180000 510000 257500 291850 ...
## $ bedrooms : int 3 2 3 3 3 3 2 3 3 5 ...
## $ bathrooms : num 1 1 2 2.25 1.5 2.5 1 1 1.75 2 ...
## $ sqft_living : int 1180 770 1680 1715 1060 3560 1160 1430 1370 1810 ...
## $ sqft_lot : int 5650 10000 8080 6819 9711 9796 6000 19901 9680 4850 ...
## $ floors : num 1 1 1 2 1 1 1 1.5 1 1.5 ...
## $ waterfront : int 0 0 0 0 0 0 0 0 0 0 ...
## $ view : int 0 0 0 0 0 0 0 0 0 0 ...
## $ condition : int 3 3 3 3 3 3 4 4 4 3 ...
## $ grade : int 7 6 8 7 7 8 7 7 7 7 ...
## $ sqft_above : int 1180 770 1680 1715 1060 1860 860 1430 1370 1810 ...
## $ sqft_basement: int 0 0 0 0 0 1700 300 0 0 0 ...
## $ yr_built : int 1955 1933 1987 1995 1963 1965 1942 1927 1977 1900 ...
## $ yr_renovated : int 0 0 0 0 0 0 0 0 0 0 ...
## $ zipcode : int 98178 98028 98074 98003 98198 98007 98115 98028 98074 98107 ...
## $ lat : num 47.5 47.7 47.6 47.3 47.4 ...
## $ long : num -122 -122 -122 -122 -122 ...
## $ sqft_living15: int 1340 2720 1800 2238 1650 2210 1330 1780 1370 1360 ...
## $ sqft_lot15 : int 5650 8062 7503 6819 9711 8925 6000 12697 10208 4850 ...
k_numericVars <- which(sapply(k_all, is.numeric)) # index vector numeric variables
k_numericVarnames <- names(k_numericVars) # 이름 명명
cat('There are', length(k_numericVars), 'numeric variables')
## There are 19 numeric variables
k_all.numVar <- k_all[, ..k_numericVars]
k_cor.numVar <- cor(k_all.numVar, use = 'pairwise.complete.obs', method="spearman") # 결측값 제외 상관행렬 생성
# price 기준 내림차순 정렬
k_cor.sorted <- as.matrix(sort(k_cor.numVar[, 'price'], decreasing = TRUE))
k_corHigh <- names(which(apply(k_cor.sorted, 1, function(x) abs(x) > 0)))
k_cor.numVar <- k_cor.numVar[k_corHigh, k_corHigh]
# 상관 행렬 히트맵
corrplot.mixed(k_cor.numVar,
tl.col = 'black', # 변수명 색깔
tl.pos = 'lt', # 변수명 왼쪽 표시
tl.cex = 0.7, # 변수명 text 크기
cl.cex = 0.7, # y축 상관계수 text 크기
number.cex = .5 # matrix안 상관계수 text 크기
)
상관 행렬 확인 결과 주거 공간의 크기, 등급, 지상 평방피트 등 상위에 공간의 면적과 관련된 항목들이 있음을 알 수 있다. 그리고 침실의 개수보단 욕실이 가격과 상관 관계가 더 높고, 한국이라면 영향이 컸을 리버뷰(waterfront)는 상관 관계가 그리 높지 않았다. 의문은 위도와는 상관 관계가 0.45이지만, 경도와는 0.07로 이건 지역의 특성인것 같은데 확인해 봐야 할 것 같다.
# grade boxplot (하등급: 1~3등급, 중등급: 7 등급, 상등급: 11~13 등급)
k_g1 <- ggplot(data=k_all[!is.na(k_all$price),], aes(x= factor(grade), y = price)) + #grade 범주형 변수로 변환
geom_boxplot(col = 'black') + labs(x = 'grade') +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
geom_text(aes(label = ifelse(k_all$grade[!is.na(k_all$price)]== 11 & k_all$price[!is.na(k_all$price)] > 7000000, rownames(k_all),''), vjust = 1.5))
k_g2 <- ggplot(data = k_all, aes(x = as.factor(grade))) +
geom_histogram(stat = 'count') +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size =3) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_g1, k_g2)
11등급인데 가격이 너무 높은 이상치가 있다. 확인해 봐야 할 것 같다.
# sqft_living 분포 확인
ggplot(data=k_all[!is.na(k_all$price)], aes(x = sqft_living, y=price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se= FALSE, color = 'black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
geom_text(aes(label = ifelse(k_all$sqft_living[!is.na(k_all$price)] > 10000, rownames(k_all), ''), vjust=1.5))
price 관측치 ’8913’은 면적 대비 가격이 낮아 보인다. 가장 상위 가격인 ’5109’와 비교해보겠다.
k_all[c(5109, 8913), c('price','sqft_living', 'grade','bathrooms', 'bedrooms')]
## price sqft_living grade bathrooms bedrooms
## 1: 7700000 12050 13 8 6
## 2: 2280000 13540 12 8 7
면적, 등급, 욕실 상태와 침실 수도 큰 차이는 안나지만 가격이 3배 차이 나는건 확인해 봐야겠다.
# sqft_living15 분포 확인
ggplot(data = k_all[!is.na(k_all$price),], aes(x = sqft_living15, y = price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
geom_text(aes(label = ifelse(sqft_living15[!is.na(k_all$price)] > 6000, rownames(k_all), ''), vjust = 1.5))
living15에서도 면적 대비 가격이 낮은 값들이 보인다. living에선 이상치가 2건 정도였는데, 여기선 꽤 많은 값들이 있다. 여기선 변별하기가 힘들것 같아 추후 다른 값에서 비교해보겠다.
# sqft_above 분포 확인
ggplot(data = k_all[!is.na(k_all$price),], aes(x = sqft_above, y = price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
geom_text(aes(label = ifelse(k_all$sqft_above[!is.na(k_all$price)] > 7500, rownames(k_all), ''), vjust= 1.5))
# bathrooms boxplot(0.5:세면대 화장실, 0.75: 0.5+샤워실, 1: 0.75+욕조)
k_b1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = factor(bathrooms), y = price)) + #bathrooms 범주형 변수로 변환
geom_boxplot( col = 'black') +labs(x = 'bathrooms') +
scale_y_continuous(breaks = seq(0,8000000, by = 1000000), labels = comma) +
geom_text(aes(label = ifelse(bathrooms[!is.na(k_all$price)]<=5.25 & price>5000000, rownames(k_all), ''), vjust = 1.5)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
k_b2 <- ggplot(data = k_all, aes(x = as.factor(bathrooms))) +
geom_histogram(stat = 'count') +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_b1, k_b2)
4.25부터 5.5까지 이상치가 존재하고, 5.5와 5.75는 최대치가 높아보인다. 확인해 봐야 할 것 같다.
# lat
ggplot(data = k_all[!is.na(k_all$price),], aes(x = lat, y = price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), label = comma) +
geom_text(aes(label = ifelse(price > 6000000, rownames(k_all), ''), vjust = 1.5))
위도가 상승할수록 가격도 오르는 걸 확인할 수 있다. 추후에 연관성이 있는 항목들을 재검토 하겠다.
# bedrooms boxplot
k_d1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = factor(bedrooms), y = price)) + # bedrooms 범주형 변수로 변환
geom_boxplot(col = 'black') + labs(x = 'bedrooms') +
scale_y_continuous(breaks = seq(0,8000000, by = 1000000), labels = comma) +
geom_text(aes(label = ifelse(price > 6000000, rownames(k_all), ''), vjust = 1.5))
k_d2 <- ggplot(data = k_all, aes(x = as.factor(bedrooms))) +
geom_histogram(stat = 'count') +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_d1, k_d2)
3,4,5,6에서 이상치가 많이 보이고, 5,6은 특출난 수치들이 있다. 확인해 봐야 할 것 같다.
k_f1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = factor(floors), y = price)) +
geom_boxplot(col = 'black') + labs(x = 'floors') +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
geom_text(aes(label = ifelse(k_all$floors[!is.na(k_all$price)]==2.5 & price > 7000000, rownames(k_all), ''), vjust = 1.5))
k_f2 <- ggplot(data= k_all, aes(x = as.factor(floors))) +
geom_histogram(stat = 'count') +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_f1, k_f2)
’5109’는 floors 변수에서도 이상치로 나타난다. 면적대비 가격이 낮으면서 2.5층의 값이다.
# view boxplot
k_v1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = factor(view), y = price)) + # view 범주형 변수로 변환
geom_boxplot(col = 'black') + labs(x = 'view') +
scale_y_continuous(breaks = seq(0,8000000, by = 1000000), label = comma) +
geom_text(aes(label = ifelse(price > 5500000, rownames(k_all), ''), vjust = 1.5))
k_v2 <- ggplot(data = k_all, aes(x = as.factor(view))) +
geom_histogram(stat = 'count') +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_v1, k_v2)
0,2,3,4가 view 대비 특출난 이상치들이 있다. 확인해 봐야 할 것 같다.
# sqft_basement 분포 확인
ggplot(data = k_all[!is.na(k_all$price),], aes(x = sqft_basement, y = price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0,8000000, by = 1000000), label = comma) +
geom_text(aes(label = ifelse(price > 6000000, rownames(k_all), ''), vjust = 1.5))
지하실 면적과 가격간의 상관은 있어보이지만, 0에 많은 수치가 몰려있다. 지하실이 없을 경우를 0으로 표현한 것 같은데, 확인해 봐야 할 것 같다.
k_w1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x= factor(waterfront), y = price)) +
geom_boxplot(col = 'black') + labs(x = 'waterfront') +
scale_y_continuous(breaks = seq(0,8000000, by = 1000000), labels = comma)
k_w2 <- ggplot(data = k_all, aes(x = as.factor(waterfront))) +
geom_histogram(stat = 'count') +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_w1, k_w2)
강이 보이는 곳이 평균적으로 가격이 높지만, 강이 안 보이더라도 비싼 곳들이 있다.
ggplot(data=k_all[!is.na(k_all$price),], aes(x = factor(yr_renovated), y = price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma)
k_all %>% select(yr_renovated) %>% table()
## .
## 0 1934 1940 1944 1945 1946 1948 1950 1951 1953 1954 1955
## 20590 1 2 1 3 2 1 2 1 3 1 3
## 1956 1957 1958 1959 1960 1962 1963 1964 1965 1967 1968 1969
## 3 3 5 1 4 2 4 5 5 2 8 4
## 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981
## 9 2 4 5 3 6 3 8 6 10 10 5
## 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993
## 11 18 18 17 17 18 15 22 25 20 17 19
## 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005
## 19 16 15 15 19 17 35 19 22 36 26 35
## 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015
## 24 35 18 22 18 13 11 37 91 16
값이 0인 값들이 많다. 재건축 유무를 구분하여 변수를 새로 만들어서 확인해봐야 할 것 같다. 년도는 테이블로 확인하였다.
ggplot(data=k_all[!is.na(k_all$price),], aes(x = factor(yr_built), y =price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se= FALSE, color ='black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
theme(axis.text.x = element_text(angle = 45, hjust =1))
k_all %>% select(yr_built) %>% table()
## .
## 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914
## 86 29 27 45 44 74 91 65 86 94 132 72 78 58 53
## 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929
## 64 79 56 120 88 98 74 94 83 139 164 179 115 126 114
## 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944
## 90 61 37 29 21 24 39 68 52 104 154 161 222 168 139
## 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959
## 94 125 262 235 191 247 228 220 220 302 267 194 198 223 333
## 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974
## 247 224 310 252 172 187 248 348 380 278 130 104 148 147 162
## 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989
## 189 252 416 384 342 237 199 103 212 227 228 215 292 267 290
## 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004
## 318 224 198 200 249 168 194 174 239 264 218 305 222 422 431
## 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015
## 450 454 416 366 228 143 130 169 200 558 38
집값과의 상관 관계는 크게 없어 보인다. 차트에선 년도가 잘 안보여 수치로 보았다. 1900년~ 2015년까지 분포되어 있다.
ggplot(data=k_all[!is.na(k_all$price),], aes(x = sqft_lot, y = price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group=1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
geom_text(aes(label = ifelse(k_all$sqft_lot[!is.na(k_all$price)] > 1500000, rownames(k_all), ''), vjust= 1.5))
summary(k_all$sqft_lot)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 520 5040 7616 15117 10686 1651359
상관 관계는 보이지만, 75%의 수가 0~1만 사이에 몰려있다. Min과 Max의 차가 굉장히 크다.
ggplot(data=k_all[!is.na(k_all$price),], aes(x = sqft_lot15, y = price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma)
ggplot(data = k_all[!is.na(k_all$price),], aes(x = long, y = price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 10000000), labels = comma)
lat과는 달리 long은 큰 상관 관계가 보이지 않는다.
k_c1 <- ggplot(data= k_all[!is.na(k_all$price),], aes(x = factor(condition), y= price)) +
geom_boxplot(col= 'black') + labs(x = 'condition') +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
geom_text(aes(label = ifelse(k_all$condition[!is.na(k_all$price)] >= 3 & price > 6000000, rownames(k_all), ''), vjust = 0.5, hjust=1.5))
k_c2 <- ggplot(k_all, aes(x = as.factor(condition))) +
geom_histogram(stat = 'count') +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
theme(axis.text.x = element_text(angle = 45, hjust =1))
grid.arrange(k_c1, k_c2)
k_z1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = as.factor(zipcode), y = price)) +
geom_point(color = 'blue') +
geom_smooth(methdo = 'lm', se= FALSE, color = 'black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 10000000), labels = comma)
k_z2 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = as.factor(zipcode), group= factor(zipcode), y = price)) +
geom_boxplot(color = 'black') +
theme_light()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma)
grid.arrange(k_z1, k_z2)
zipcode는 추후 다시 살펴봐야겠다.
건축년도로 구분한 집의 년수와, 리모델링 여부, 신축 여부를 구분 지어 변수를 만들겠다.
k_all$Remod <- ifelse(k_all$yr_built > k_all$yr_renovated, 0, 1) # 0 = '리모델링 X', 1 = '리모델링'
temp <- ifelse(k_all$yr_renovated==0, k_all$yr_built, k_all$yr_renovated) #재건축이 아니면 디폴트로 건축년도 설정
k_all$Age <- as.numeric(k_all$Yrbuy)-temp
ggplot(k_all[!is.na(k_all$price),], aes(x = Age, y=price)) +
geom_point(col = 'blue') +
geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
geom_text(aes(label=ifelse(price > 7000000, rownames(k_all), ''), vjust = 0.5))
재건축을 하거나, 건축된지 30년 미만의 집이 고가에 거래된 경우가 많다.
ggplot(k_all[!is.na(k_all$price),], aes(x = as.factor(Remod), y = price)) +
geom_bar(stat = 'summary', fun.y = 'median', fill = 'blue') +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 6) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
theme_grey(base_size = 18)+
geom_hline(yintercept = 450000, linetype = 'dashed')
재건축된 집이 더 비싸다.
k_all$IsNew <- ifelse(k_all$yr_renovated>=2014, 1, 0) # 1은 신축, 0은 기
table(k_all$IsNew)
##
## 0 1
## 21396 107
107채의 14년 이후 신축집은 train과 test셋에 분배되어 있으며, 기존 집들보다 더 비싼 경향을 보인다.
ggplot(k_all[!is.na(k_all$price),], aes(x = as.factor(IsNew), y = price)) +
geom_bar(stat = 'summary', fun.y = 'median', fill = 'blue') +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 6) +
scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
theme_light() +
geom_hline(yintercept = 450000, linetype='dashed') # 점선은 판매가의 중위값
zipcode 라이브러리를 써서 zipcode별 city를 변수로 추가하겠다.
zc <- data.frame(k_all$zipcode) # zipcode 변수 추출
data(zipcode) # zipcode 라이브러리에서 변수 생성
colnames(zc)[1]='zip' # join 사전작업 컬럼명 동일하게 변경
zipcode$zip=as.integer(zipcode$zip) # join 사전작업 character > int로 변환
zc = left_join(zc,zipcode,by='zip') # left_join으로 'zc' 기준 결합
zc = zc %>% select(-'state') # 모든 state가 'WA'로 동일하므로 state 컬럼 삭제
k_all <- mutate(k_all, city= zc$city) # city 변수 추가
city별 가격 분포 확인
ggplot(data = k_all[!is.na(k_all$price),], aes(x = city, group= city, y = price)) +
geom_boxplot(color = 'black') +
theme_light()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
scale_y_continuous(labels = comma)
ggplot(k_all[!is.na(k_all$price),], aes(x = city)) +
geom_histogram(stat = 'count') +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
theme(axis.text.x = element_text(angle = 45, hjust =1))
## Warning: Ignoring unknown parameters: binwidth, bins, pad
’Seattle’과 ’Bellevue’는 분포가 많고, 이상치들로 가격대가 높은 집들이 좀 있어 보이고, ’Medina’는 분포 대비 부촌으로 보인다.(36채로 가장 적은 분포)
k_zc1 <- ggplot(k_all[!is.na(k_all$price),], aes(x = reorder(city, price, FUN = median), y = price))+
geom_bar(stat = 'summary', fun.y = 'median', fill = 'blue') +
labs(x = 'city', y = 'Median_price') +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels = comma) +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 2.5) +
geom_hline(yintercept = 450000, linetype = 'dashed', color = 'red')
k_zc2 <- ggplot(k_all[!is.na(k_all$price),], aes(x = reorder(city, price, FUN = mean), y = price))+
geom_bar(stat = 'summary', fun.y = 'mean', fill = 'blue') +
labs(x = 'city', y = 'Mean_price') +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels = comma) +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 2.5) +
geom_hline(yintercept = 450000, linetype = 'dashed', color = 'red')
grid.arrange(k_zc1, k_zc2)
평균값과 중위값은 ’Medina’가 가장 높고, 그 다음이 지도상으로 그 바로 아래 위치한 ’Mercer Island’이다. 이 변수에서 위도와 가격과의 상관 관계가 높게 나왔을 것으로 추측된다.(경도는 비슷, 위도가 약간 아래) 분포가 많았던 ’Seattle’은 분포와 가격과의 상관은 크게 없어 보인다.
k_zc3 <- ggplot(k_all[!is.na(k_all$price),], aes(x = reorder(city, price, FUN = max), y = price))+
geom_bar(stat = 'summary', fun.y = 'max', fill = 'blue') +
labs(x = 'city', y = 'Max_price') +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels = comma) +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 2.5) +
geom_hline(yintercept = 450000, linetype = 'dashed', color = 'red')
k_zc4 <- ggplot(k_all[!is.na(k_all$price),], aes(x = reorder(city, price, FUN = min), y = price))+
geom_bar(stat = 'summary', fun.y = 'min', fill = 'blue') +
labs(x = 'city', y = 'Min_price') +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels = comma) +
geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 2.5) +
geom_hline(yintercept = 450000, linetype = 'dashed', color = 'red')
grid.arrange(k_zc3, k_zc4)
최대값을 보면 처음에 봤던 박스 플롯의 분포를 확인할 수 있고, 최소값을 보면 ’Medina’와 ’Mercer Island’는 타 지역대비 높은 값을 보이는 걸 알 수 있다. 상기의 도시별 차트들을 보면 시애틀과 벨뷰에 많은 인구가 살고, 메디나와 머서 아일랜드에는 높은 가격대의 집들이 있어 이들 일대가 시가지이고, 이 곳에서 멀어질수록 가격도 낮아지고, 분포도 적은 것을 알 수 있다.
’Medina’와 ’Mercer Island’는 가격과 상관도가 높은 변수이다. 그래서 이 둘을 묶은 변수를 하나 추가하겠다.
k_all$mecity <- ifelse(k_all$city=='Medina' | k_all$city=='Mercer Island', 1, 0) # 1은 부촌, 0은 그 외
부지 기준 평당 단가와 건물 기준 평당 단가 변수 생성
livingp <- k_all[!is.na(k_all$price),] %>% group_by(zipcode) %>% summarise(mean_living_per_price=mean(price/sqft_living), mean_lot_per_price=mean(price/sqft_lot))
#k_all <- left_join(k_all, livingp, by = 'zipcode') %>% as.data.table
#k_all$living_per_price <- k_all$price/k_all$sqft_living
#k_all$lot_per_price <- k_all$price/k_all$sqft_lot
str(livingp)
## 'data.frame': 1 obs. of 2 variables:
## $ mean_living_per_price: num 264
## $ mean_lot_per_price : num 88.7
도시별 가격을 비교했을 때 봤던 것과 같이 건물당 단가는 ‘Medina’, ‘Mercer Island’, ‘Bellevue’ 순으로 동일하다. 하지만 부지당 단가로 비교하면 건물당 단가일때는 4,9번째였던 ‘Seattle’과 ’Issaquah’가 1,3번째로 높게 나온다. 이들 두 곳은 건물 대비해서 부지가 넓어 보인다. ’Medina’와 ’Mercer Island’,’Belleuvue’는 부지보단 건물로 인해 가격이 높게 나오는 것 같다.
상기 부지당 평단가와 건물당 평단가를 비교한 상기의 변수에서 좀 더 확인하기 위해 추가했다.
k_all$living_divide_lot <- k_all$sqft_living/k_all$sqft_lot
ggplot(k_all[!is.na(k_all$price),], aes(x = reorder(city, living_divide_lot, FUN = mean), y = living_divide_lot))+
geom_bar(stat = 'summary', fun.y = 'mean', fill = 'blue') +
labs(x = 'city', y = 'living_divide_lot') +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(breaks = seq(0, 5, by = 1),labels = comma)
‘bathrooms’ + ‘bedrooms’해서 ’TotalRooms’ 변수를 만들겠다.
k_all$TotalRooms <- k_all$bathrooms + k_all$bedrooms
부지당 평단가가 높았던’Issaquah’와 ’Seattle’이 주거 공간 대비 부지의 공간이 넓다. (수정중)
#living15 변수 의미 파악 위한 작업
#living15 <- k_all[!is.na(k_all$price),] %>% filter(city == 'Medina') %>% select(lat, long, sqft_living, sqft_living15, sqft_lot, sqft_lot15, living_divide_lot) %>% arrange(desc(lat))
#Medina <- k_all[!is.na(k_all$price),] %>% filter(city == 'Medina') %>% arrange(desc(lat))
#k_all[!is.na(k_all$price),] %>% filter(city == 'Medina' , (lat >= 47.63 & lat< 47.64)) %>% select(lat, long, sqft_living, sqft_living15, sqft_lot, sqft_lot15) %>% arrange(desc(lat))
FE 끝난 시점에서 상관 관계를 다시 확인해 보겠다.
k_all3 <- as.data.table(k_all) # 상관 행렬위해 임시 data.table 생성
k_again.numericVars <- which(sapply(k_all3, is.numeric))
k_again.numericVarnames <- names(k_again.numericVars)
cat('there are', length(k_again.numericVars), 'numeric variables')
## there are 25 numeric variables
k_again.all.numVar <- k_all3[, ..k_again.numericVars]
k_again.cor.numVar <- cor(k_again.all.numVar, use = 'pairwise.complete.obs', method = 'spearman')
k_again.cor.sorted <- as.matrix(sort(k_again.cor.numVar[, 'price'], decreasing = TRUE))
k_again.corHigh <- names(which(apply(k_again.cor.sorted, 1, function(x) abs(x) > 0)))
k_again.cor.numVar <- k_again.cor.numVar[k_again.corHigh, k_again.corHigh]
corrplot.mixed(k_again.cor.numVar,
tl.col = 'black',
tl.pos = 'lt',
tl.cex = 0.7,
cl.cex = 0.7,
number.cex = .5)
참조 & 필사한 링크를 첨부한다. ’erikbruin’의 링크를 참조하다 에러가 나는 부분이 많아, 아래 ’psystat’님의 커널을 필사했다. 들어가는 변수가 달라 점수는 차이가 많이 난다. 컴퍼티션 기일 전날까지 변수 와 모델링은 수정할 예정이다.
https://www.kaggle.com/erikbruin/house-prices-lasso-xgboost-and-a-detailed-eda
https://www.kaggle.com/psystat/eda-and-lasso-rf-svm-xgb-grid-search/code
outlier <- k_all[c(2776,5109,8913,13810,7247,3135), c('price','city','sqft_living','sqft_lot','living_divide_lot')]
outlier
## price city sqft_living sqft_lot living_divide_lot
## 1: 7062500 Bellevue 10040 37325 0.26898861
## 2: 7700000 Seattle 12050 27600 0.43659420
## 3: 2280000 Redmond 13540 307752 0.04399646
## 4: 2700000 Issaquah 7850 89651 0.08756177
## 5: 2983000 Bellevue 7400 18898 0.39157583
## 6: 5570000 Medina 9200 35069 0.26233996
#2776, 5109는 대조군으로 두고 면적 대비 가격이 낮았던 '8913',' '13810', '7247'과 view가 0등급인데 가격이 높았던 '3135'를 이상치로 정하고 데이터를 확인해 보겠다.
대조군 대비 ‘8913’, ’13810’의 부지당 평단가가 너무 낮다. 대조군이 100단위인 반면, 이 두 이상치는 1,2자리이다. 이상치로 잡고 제거하겠다.
k_all <- k_all[-c(8913,13810),]
k_all[, Yrmbuy:=factor(Yrmbuy)]
k_all[, zipcode:=factor(zipcode)]
k_all[, city:=factor(city)]
k_all[, mecity:=factor(mecity)]
k_all[, waterfront:=factor(waterfront)]
k_all[, IsNew:=factor(IsNew)]
k_all[, Remod:=factor(Remod)]
k_all[, view:=factor(view)]
k_all[, grade:=factor(grade)]
k_all[, floors:=factor(floors)]
k_all[, TotalRooms:=factor(TotalRooms)]
k_all[, condition:=factor(condition)]
cat_vars <- c('waterfront', 'Yrmbuy','zipcode','mecity','city','IsNew','condition','Remod','view','grade','floors','TotalRooms') # 가져갈 변수
del_vars <- c('price','Yrbuy','Mobuy','date', 'yr_built','yr_renovated') #제거할 변수
num_vars <- setdiff(colnames(k_all), c(cat_vars, del_vars)) #del_var 제외 변수 추출
str(k_all)
## Classes 'data.table' and 'data.frame': 21501 obs. of 30 variables:
## $ date : chr "20141013" "20150225" "20150218" "20140627" ...
## $ price : num 221900 180000 510000 257500 291850 ...
## $ bedrooms : int 3 2 3 3 3 3 2 3 3 5 ...
## $ bathrooms : num 1 1 2 2.25 1.5 2.5 1 1 1.75 2 ...
## $ sqft_living : int 1180 770 1680 1715 1060 3560 1160 1430 1370 1810 ...
## $ sqft_lot : int 5650 10000 8080 6819 9711 9796 6000 19901 9680 4850 ...
## $ floors : Factor w/ 6 levels "1","1.5","2",..: 1 1 1 3 1 1 1 2 1 2 ...
## $ waterfront : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ view : Factor w/ 5 levels "0","1","2","3",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ condition : Factor w/ 5 levels "1","2","3","4",..: 3 3 3 3 3 3 4 4 4 3 ...
## $ grade : Factor w/ 12 levels "1","3","4","5",..: 6 5 7 6 6 7 6 6 6 6 ...
## $ sqft_above : int 1180 770 1680 1715 1060 1860 860 1430 1370 1810 ...
## $ sqft_basement : int 0 0 0 0 0 1700 300 0 0 0 ...
## $ yr_built : int 1955 1933 1987 1995 1963 1965 1942 1927 1977 1900 ...
## $ yr_renovated : int 0 0 0 0 0 0 0 0 0 0 ...
## $ zipcode : Factor w/ 70 levels "98001","98002",..: 67 17 38 3 69 7 50 17 38 46 ...
## $ lat : num 47.5 47.7 47.6 47.3 47.4 ...
## $ long : num -122 -122 -122 -122 -122 ...
## $ sqft_living15 : int 1340 2720 1800 2238 1650 2210 1330 1780 1370 1360 ...
## $ sqft_lot15 : int 5650 8062 7503 6819 9711 8925 6000 12697 10208 4850 ...
## $ Yrbuy : chr "2014" "2015" "2015" "2014" ...
## $ Mobuy : chr "10" "02" "02" "06" ...
## $ Yrmbuy : Factor w/ 13 levels "201405","201406",..: 6 10 10 2 9 12 1 1 6 11 ...
## $ Remod : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ Age : num 59 82 28 19 52 50 72 87 37 115 ...
## $ IsNew : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ city : Factor w/ 24 levels "Auburn","Bellevue",..: 21 11 20 9 21 2 21 11 20 21 ...
## $ mecity : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ living_divide_lot: num 0.209 0.077 0.208 0.252 0.109 ...
## $ TotalRooms : Factor w/ 55 levels "0","0.75","1",..: 14 10 18 19 16 20 10 14 17 26 ...
## - attr(*, ".internal.selfref")=<externalptr>
# 수치형 변수 표준화
X_train_num <- k_all[!is.na(k_all$price), num_vars, with=F]
X_test_num <- k_all[is.na(k_all$price), num_vars, with=F]
mean.tr <- apply(X_train_num, 2, mean)
sd.tr <- apply(X_train_num, 2, sd)
X_train_num <- scale(X_train_num, center = mean.tr, scale = sd.tr)
X_test_num <- scale(X_test_num, center = mean.tr, scale = sd.tr)
X_train <- model.matrix(~.-1, data=cbind(X_train_num, k_all[!is.na(k_all$price), cat_vars, with=F]))
X_test <- model.matrix(~.-1, data = cbind(X_test_num, k_all[is.na(k_all$price), cat_vars, with=F]))
Y_train <- log(k_all[!is.na(k_all$price), price])
##LASSO
RMSE_exp <- function (data, lev = NULL, model = NULL) {
out <- sqrt(mean((exp(data$obs) - exp(data$pred))^2))
names(out) <- "RMSE_exp"
out
}
tic('LASSO')
set.seed(0418)
k_control <- trainControl(method = 'cv', number = 5, summaryFunction = RMSE_exp)
tuneGrid <- expand.grid(alpha = 1, lambda = c(0.000001, 0.00001, 0.0001, 0.001, 0.01, 0.1))
fit.lasso <- train(x = as.matrix(X_train), y= Y_train,
method = 'glmnet',
metric = 'RMSE',
maximize = FALSE,
trControl = k_control,
tuneGrid = tuneGrid)
## Warning in load(system.file("models", "models.RData", package = "caret")):
## strings not representable in native encoding will be translated to UTF-8
## Warning in train.default(x = as.matrix(X_train), y = Y_train, method =
## "glmnet", : The metric "RMSE" was not in the result set. RMSE_exp will be
## used instead.
toc()
## LASSO: 6.28 sec elapsed
fit.lasso
## glmnet
##
## 15033 samples
## 199 predictor
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 12027, 12027, 12025, 12026, 12027
## Resampling results across tuning parameters:
##
## lambda RMSE_exp
## 1e-06 141953.8
## 1e-05 141953.8
## 1e-04 141963.2
## 1e-03 138149.0
## 1e-02 146931.0
## 1e-01 256207.5
##
## Tuning parameter 'alpha' was held constant at a value of 1
## RMSE_exp was used to select the optimal model using the smallest value.
## The final values used for the model were alpha = 1 and lambda = 0.001.
fit.lasso$bestTune
## alpha lambda
## 4 1 0.001
min(fit.lasso$results$RMSE_exp)
## [1] 138149
lasso.varimp <- varImp(fit.lasso, scale = F)
lasso.imp <- lasso.varimp$importance
lasso.importance <- data.frame(variable = rownames(lasso.imp), importance = lasso.imp$Overall) %>%
arrange((importance))
lasso.importance$variable <- factor(lasso.importance$variable, levels = lasso.importance$variable, labels = lasso.importance$variable)
num.vars.selected <- length(which(lasso.importance$importance!=0))
num.vars.not.selected <- length(which(lasso.importance$importance==0))
cat('Lasso uses', num.vars.selected, 'variables in its model, and did not select', num.vars.not.selected, 'variables')
## Lasso uses 156 variables in its model, and did not select 43 variables
lasso.importance[which(lasso.importance$importance!=0),] %>%
ggplot(aes(x=variable, y=importance, fill=variable)) +
geom_bar(alpha=0.5, stat='identity') +
coord_flip() + # 가로 barplot
theme_light() + theme(legend.position = "none")
as.character(lasso.importance$variable[which(lasso.importance$importance==0)])
## [1] "sqft_basement" "long" "sqft_lot15"
## [4] "Yrmbuy201407" "Yrmbuy201410" "Yrmbuy201412"
## [7] "Yrmbuy201501" "zipcode98003" "zipcode98007"
## [10] "zipcode98024" "zipcode98027" "zipcode98030"
## [13] "zipcode98040" "zipcode98042" "zipcode98053"
## [16] "zipcode98056" "zipcode98072" "zipcode98074"
## [19] "cityBothell" "cityCarnation" "cityDuvall"
## [22] "cityFall City" "cityKenmore" "cityKirkland"
## [25] "cityMedina" "cityMercer Island" "cityRenton"
## [28] "condition3" "grade3" "grade8"
## [31] "floors2.5" "floors3.5" "TotalRooms2.25"
## [34] "TotalRooms4.25" "TotalRooms6" "TotalRooms6.75"
## [37] "TotalRooms7.5" "TotalRooms8.25" "TotalRooms8.75"
## [40] "TotalRooms11" "TotalRooms12.5" "TotalRooms13"
## [43] "TotalRooms34.75"
predictions_lasso <- exp(predict(fit.lasso, X_test))
head(predictions_lasso)
## 1 2 3 4 5 6
## 544987.2 506684.5 1542874.1 326338.8 320944.5 326151.1
submission_lasso <- read.csv('./kako 2nd/sample_submission.csv')
submission_lasso$price <- predictions_lasso
write.csv(submission_lasso, file = 'submission_lasso.csv', row.names = F)
tuneGrid <- expand.grid(
max_depth = c(6, 60), #default: 6
subsample = c(0.8, 1), #default: 1
colsample_bytree = c(0.9, 1) #default: 1
)
RMSE_exp <- function(preds, dtrain) {
labels <- xgboost::getinfo(dtrain, 'label')
err <- sqrt(mean((exp(labels) -exp(preds))^2))
return(list(metric = 'RMSE_exp', value = err))
}
# Dmatrix로 testing & training data 분리
dtrain <- xgb.DMatrix(data = as.matrix(X_train), label = Y_train)
dtest <- xgb.DMatrix(data = as.matrix(X_test))
results <- list(val_rmse = rep(0, nrow(tuneGrid)),
nrounds = rep(0, nrow(tuneGrid)))
for ( i in 1:nrow(tuneGrid)){
params <- list(
objective = 'reg:linear',
metric = 'rmse',
booster = 'gbtree',
eta = 0.01, #default: 0.3
gamma = 0, #default: 0
min_child_weight =1, #default: 1
max_depth = tuneGrid[i, 'max_depth'],
subsample = tuneGrid[i, 'subsample'],
colsample_bytree = tuneGrid[i, 'colsample_bytree']
)
}
** cross validation **
# tic('xgbcv')
xgbcv <- xgb.cv(params = params,
data = dtrain,
nrounds = 10000,
nfold = 5,
feval = RMSE_exp,
print_every_n = 100,
early_stopping_rounds = 100,
maximize = F,
seed=4018)
## [1] train-RMSE_exp:655419.825393+2921.701786 test-RMSE_exp:655323.559028+11656.376213
## Multiple eval metrics are present. Will use test_RMSE_exp for early stopping.
## Will train until test_RMSE_exp hasn't improved in 100 rounds.
##
## [101] train-RMSE_exp:650634.685487+2935.851197 test-RMSE_exp:650542.222057+11731.543974
## [201] train-RMSE_exp:559037.710743+3050.720191 test-RMSE_exp:559319.689872+13214.710928
## [301] train-RMSE_exp:357677.052412+3181.334054 test-RMSE_exp:361539.386816+17473.688044
## [401] train-RMSE_exp:194696.650231+2615.220915 test-RMSE_exp:217386.020635+19694.453508
## [501] train-RMSE_exp:100271.107909+1482.049506 test-RMSE_exp:157179.871919+20502.009243
## [601] train-RMSE_exp:51427.714980+944.016269 test-RMSE_exp:136059.104656+19732.571760
## [701] train-RMSE_exp:27137.841107+693.215882 test-RMSE_exp:127777.868486+17605.990539
## [801] train-RMSE_exp:15022.846038+486.756401 test-RMSE_exp:124713.029052+16291.673003
## [901] train-RMSE_exp:8589.882900+323.347487 test-RMSE_exp:123428.183212+15604.328623
## [1001] train-RMSE_exp:5023.638203+204.781119 test-RMSE_exp:122859.244510+15110.679485
## [1101] train-RMSE_exp:2973.263161+135.975261 test-RMSE_exp:122574.095736+14779.306337
## [1201] train-RMSE_exp:1778.763823+80.046641 test-RMSE_exp:122427.498689+14580.411372
## [1301] train-RMSE_exp:1088.939046+48.068356 test-RMSE_exp:122348.590648+14457.837507
## [1401] train-RMSE_exp:698.005369+29.361926 test-RMSE_exp:122308.292041+14381.733724
## [1501] train-RMSE_exp:519.521226+12.239330 test-RMSE_exp:122283.269558+14345.479406
## [1601] train-RMSE_exp:466.419056+8.647863 test-RMSE_exp:122272.452031+14322.571500
## [1701] train-RMSE_exp:442.566749+9.345404 test-RMSE_exp:122266.234532+14309.839791
## [1801] train-RMSE_exp:440.676251+10.418822 test-RMSE_exp:122266.292226+14309.624724
## Stopping. Best iteration:
## [1702] train-RMSE_exp:442.445924+9.359117 test-RMSE_exp:122266.183711+14309.746564
# toc()
results[['val_rmse']][i] <- unlist(xgbcv$evaluation_log[xgbcv$best_iteration, 'test_RMSE_exp_mean'])
results[['nrounds']][i] <- xgbcv$best_iteration
min.index <- which.min(results[['val_rmse']])
tuneGrid[min.index,]
## max_depth subsample colsample_bytree
## 1 6 0.8 0.9
cbind(tuneGrid, RMSE = unlist(results[['val_rmse']]))
## max_depth subsample colsample_bytree RMSE
## 1 6 0.8 0.9 0.0
## 2 60 0.8 0.9 0.0
## 3 6 1.0 0.9 0.0
## 4 60 1.0 0.9 0.0
## 5 6 0.8 1.0 0.0
## 6 60 0.8 1.0 0.0
## 7 6 1.0 1.0 0.0
## 8 60 1.0 1.0 122266.2
default_param <- list(objective = 'reg:linear',
booster = 'gbtree',
eta = 0.01,
gamma = 0,
min_child_weight = 1,
max_depth = tuneGrid[min.index, "max_depth"],
subsample = tuneGrid[min.index, "subsample"],
colsample_bytree = tuneGrid[min.index, "colsample_bytree"]
)
fit.xgb <- xgb.train(data=dtrain,
params = default_param,
nrounds = results[['nrounds']][min.index],
seed = 4018)
predictions_xgb <- exp(predict(fit.xgb, dtest))
head(predictions_xgb)
## [1] 2.141793 2.094587 2.141793 2.094587 2.094587 2.104560
submission_xgb <- read.csv('./kako 2nd/sample_submission.csv')
submission_xgb$price <- predictions_xgb
write.csv(submission_xgb, file = 'submission_xgb.csv', row.names = F)
Lasso와 XGBoost의 결과값 앙상블
k_sub.avg <- data.frame(ID=k_test.labels, price = (2*predictions_xgb + predictions_lasso)/3)
head(k_sub.avg)
## ID price
## 1 15035 181663.8
## 2 15036 168896.2
## 3 15037 514292.8
## 4 15038 108781.0
## 5 15039 106982.9
## 6 15040 108718.4
write.csv(k_sub.avg, file = 'average.csv', row.names = F)